on error resume next
Dim ActiveCmd:ActiveCmd = "2"

'##################################################
'##################################################
'##################################################

' 创建字典对象
Dim objDict
Set objDict = CreateObject("Scripting.Dictionary")
' 设置目标目录和文件后缀
Dim targetFolder, fileExtension
fileExtension = ".vbs"
main
' 清理对象
Set objDict = Nothing
sub main()	
	envVarName ="EXP_SHORTCUTS_ROOT"
	dim root:root = GetEnv(envVarName)'"C:\MentorGraphics\2005EXP\SDD_HOME\pvtk\env\"
	if root ="" then 
		msgbox "please set env value (EXP_SHORTCUTS_ROOT = ?)"
		exit sub
	end if
	
	targetFolder = root & "skill\B"
	InitDict
	dim cmdparam 
	cmdparam = GetRegistryValue("HKCU", "Software\MyApp", "EXP_Command", "REG_SZ")
	if trim(cmdparam)="" then
		cmdparam = "cl " & ActiveCmd
		application.gui.processkeyin(cmdparam)
	else
		UpdateCommand		
	end if	
end sub

'##################################################
'###  Top Level (Get root Path from system env)
'##################################################
function GetEnv(envVarName)
	On Error Resume Next
	' 创建Shell对象并获取值
	Set WshShell = CreateObject("WScript.Shell")
	envValue = WshShell.Environment("PROCESS")(envVarName) ' 优先查找进程级变量

	' 如果未找到则尝试系统级变量
	If Err.Number <> 0 Or envValue = "" Then
		Err.Clear
		envValue = WshShell.Environment("SYSTEM")(envVarName)
	End If

	' 如果仍未找到则尝试用户级变量
	If Err.Number <> 0 Or envValue = "" Then
		Err.Clear
		envValue = WshShell.Environment("USER")(envVarName)
	End If

	' 检查结果并输出
	If Err.Number = 0 And envValue <> "" Then
		GetEnv=envValue
	Else
		GetEnv=""
	End If
end function


' 设置注册表值函数
' 参数:
'   rootKey - 注册表根键 (如 "HKCU", "HKLM")
'   keyPath - 键路径 (如 "Software\MyApp")
'   valueName - 值名称
'   valueData - 要设置的值
'   valueType - 值类型 (默认为字符串, 可选: "REG_SZ", "REG_DWORD", "REG_BINARY")
Function SetRegistryValue(rootKey, keyPath, valueName, valueData, valueType)
    On Error Resume Next
    Dim shell, fullPath, regValue
    
    Set shell = CreateObject("WScript.Shell")
    
    ' 验证并转换根键
    Select Case UCase(rootKey)
        Case "HKCU": fullPath = "HKEY_CURRENT_USER\" & keyPath
        Case "HKLM": fullPath = "HKEY_LOCAL_MACHINE\" & keyPath
        Case "HKCR": fullPath = "HKEY_CLASSES_ROOT\" & keyPath
        Case "HKU":  fullPath = "HKEY_USERS\" & keyPath
        Case Else
            'SetRegistryValue = "错误: 无效的根键"
            Exit Function
    End Select
    
    ' 设置默认值类型
    If IsEmpty(valueType) Or valueType = "" Then valueType = "REG_SZ"
    
    ' 创建键路径 (如果不存在)
    shell.RegWrite fullPath & "\", "", "REG_SZ"
    
    ' 写入值
    shell.RegWrite fullPath & "\" & valueName, valueData, valueType
    
    If Err.Number <> 0 Then
        'SetRegistryValue = "错误: " & Err.Description
        Err.Clear
    Else
        'SetRegistryValue = "写入成功"
    End If
End Function


' 获取注册表值函数
' 参数:
'   rootKey - 注册表根键
'   keyPath - 键路径
'   valueName - 值名称
'   defaultValue - 可选，当值不存在时返回的默认值
Function GetRegistryValue(rootKey, keyPath, valueName, defaultValue)
    On Error Resume Next
    Dim shell, fullPath, regValue
    
    Set shell = CreateObject("WScript.Shell")
    
    ' 验证并转换根键
    Select Case UCase(rootKey)
        Case "HKCU": fullPath = "HKEY_CURRENT_USER\" & keyPath
        Case "HKLM": fullPath = "HKEY_LOCAL_MACHINE\" & keyPath
        Case "HKCR": fullPath = "HKEY_CLASSES_ROOT\" & keyPath
        Case "HKU":  fullPath = "HKEY_USERS\" & keyPath
        Case Else
            'GetRegistryValue = "错误: 无效的根键"
            Exit Function
    End Select
    
    ' 尝试读取值
    regValue = shell.RegRead(fullPath & "\" & valueName)
    
    If Err.Number <> 0 Then
        ' 值不存在时返回默认值
        If Not IsEmpty(defaultValue) Then
            GetRegistryValue = defaultValue
        Else
            'GetRegistryValue = "错误: 值不存在"
        End If
        Err.Clear
    Else
        GetRegistryValue = regValue
    End If
End Function

sub UpdateCommand()
	dim cmdparam 
	cmdparam = GetRegistryValue("HKCU", "Software\MyApp", "EXP_Command", "REG_SZ")
	cmdparam = cmdparam & ActiveCmd

	cmdparam = lcase(cmdparam)
	dim filepath		
	if objDict.exists(cmdparam) then	
		filepath = targetFolder & "\" & cmdparam & fileExtension
		dim ocmd : ocmd = "run " & chr(34) & filepath & chr(34)
		application.gui.processkeyin(ocmd)
		cmdparam =""
	end if	
	
	call SetRegistryValue("HKCU", "Software\MyApp", "EXP_Command", cmdparam, "REG_SZ")
end sub


sub InitDict()
	' 验证目录是否存在
	Dim objFSO
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	If Not objFSO.FolderExists(targetFolder) Then
		'MsgBox "指定目录不存在！", vbCritical
		exit sub
	End If

	' 获取文件列表并存入字典
	Dim objFolder, objFile
	Set objFolder = objFSO.GetFolder(targetFolder)

	For Each objFile In objFolder.Files
		' 检查文件后缀匹配（不区分大小写）
		If LCase(objFSO.GetExtensionName(objFile.Name)) = LCase(fileExtension) Or _
		   LCase(Right(objFile.Name, Len(fileExtension))) = LCase(fileExtension) Then
			' 键=文件名（不含路径），值=完整路径
			If Not objDict.Exists(objFile.Name) Then
				'objDict.Add objFile.Name, objFile.Path
				s = split(objFile.Name,".")
				objDict.Add s(0), objFile.Path
			End If
		End If
	Next
	Set objFolder = Nothing
end sub



